perm filename ALC.SAI[AL,HE]1 blob sn#290075 filedate 1977-06-28 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "alc"  COMMENT   Source files
C00005 00003	EXTERNAL INTEGER RPGSW	! Tells if run by other program (parser or snail)
C00010 ENDMK
C⊗;
BEGIN "alc"  COMMENT   Source files;

DEFINE RHT = "FALSE";

REQUIRE "ABBREV.SAI[AL,HE]" SOURCE_FILE;
REQUIRE "RECAUX.HDR[AL,HE]" SOURCE_FILE;
REQUIRE "PRINTX.HDR[AL,HE]" SOURCE_FILE;
REQUIRE "SNAILR.SAI[AL,HE]" SOURCE_FILE;

REQUIRE 300 SYSTEM!PDL;

REQUIRE "ALREC.REL[AL,HE]" LOAD_MODULE;
    DEFINE RCELL = "RPTR(CELL)";
    EXTERNAL RECORD_CLASS VARIABLE (RANY ITEMVAR NAME;INTEGER DATATYPE, OFFSET);

REQUIRE "WLDMOD.REL[AL,HE]" LOAD_MODULE;
    EXTERNAL RANY PROCEDURE STINTERP(RANY S);
    EXTERNAL RANY PROCEDURE STTBLK(RANY S);
    EXTERNAL RECURSIVE PROCEDURE WLDASG(RANY S; ITEMVAR
        IW;REFERENCE ITEMVAR OW;REFERENCE BOOLEAN NFLAG);
    EXTERNAL ITEMVAR PROCEDURE NEWWLD;  ! Actually in PMATCH;

REQUIRE "ALPRIN.HDR[AL,HE]" SOURCE_FILE;
    EXTERNAL SIMPLE PROCEDURE INI_OUTPUT;	! from iomodx;

REQUIRE "GOBBLE.HDR[AL,HE]" SOURCE_FILE;

REQUIRE "PASS3.REL[AL,HE]" LOAD_MODULE;
    EXTERNAL RECURSIVE PROCEDURE TSCAN (RANY PARSETREE);
    EXTERNAL PROCEDURE COMERR(STRING MES);
    EXTERNAL PROCEDURE INITOUT(STRING FNAME,PPN);
    EXTERNAL PROCEDURE CLOSEOUT;

REQUIRE "TCALC.REL[AL,HE]" LOAD_MODULE;

EXTERNAL ITEMVAR CURWLD;

PROCEDURE GCKILL;
  BEGIN
    REQUIRE "SYS:GOGTAB.DEF" SOURCE_FILE;
    EXTERNAL INTEGER ARRAY GOGTAB[0:1000];
    GOGTAB[RGCOFF] ← TRUE;		! Turn off garbage collection;
  END;

STRING PROCEDURE GETPPN;
  BEGIN
    STRING P,PN;
    P←CVXSTR(CALL(0,"DSKPPN"))[1 FOR 3];
    PN←CVXSTR(CALL(0,"DSKPPN"))[4 FOR 3];
    WHILE P=" " DO P←P[2 FOR ∞];
    WHILE PN=" " DO PN←PN[2 FOR ∞];
    RETURN("["&P&","&PN&"]")
  END;
EXTERNAL INTEGER RPGSW;	! Tells if run by other program (parser or snail);
PRELOAD_WITH CVSIX("SYS"),CVSIX("PALX"),CVSIX("DMP"),0,0,0;
SAFE INTEGER ARRAY RUN[1:6];
BOOLEAN NF; ! Who knows what this does;
RCELL SE; ! For the result of READ;
RANY ST; ! For the result of GROVEL;
RANY BS;  ! For the result of STTBLK;

GCKILL;
CURWLD ← NEWWLD;

IF RPGSW THEN
BEGIN  "rpg mode"
    BOOLEAN BRK,SAVE_SEXPR;
    INTEGER CHN;
    STRING COMMAND,PALX_LST;
    RPTR(FILE) SEX_FILE,OUT_FILE,LST_FILE;
    RPTR(FILE_SWITCH) SWITCH;

    OUT_FILE←NEW_RECORD(FILE);
    LST_FILE←NEW_RECORD(FILE);

    COMMAND ← TMPIN("ALC",BRK);
    IF BRK THEN USERERR(0,0,"TMPIN lost") ELSE PRINT("ALC"&CRLF);
    SEX_FILE ← SCAN_COMMAND(COMMAND,OUT_FILE,LST_FILE);
    SWITCH←FILE:SWITCHES[SEX_FILE];
    WHILE SWITCH≠NULL_RECORD DO
    BEGIN
	IF EQU("L",FILE_SWITCH:NAME[SWITCH]) ∧ FILE_SWITCH:OCTAL[SWITCH]=0 THEN
	    PALX_LST←","&FILE:NAME[OUT_FILE]&".LST"
	ELSE IF EQU("S",FILE_SWITCH:NAME[SWITCH]) ∧ FILE_SWITCH:OCTAL[SWITCH]=0 THEN
	    SAVE_SEXPR←TRUE;
	SWITCH←FILE_SWITCH:NEXT[SWITCH]
    END;

    SE←FREAD(FILE:NAME[SEX_FILE]&"."&FILE:EXT[SEX_FILE]&FILE:PPN[SEX_FILE]);
    ST←GROVEL(SE);

    IF ¬SAVE_SEXPR THEN		! delete ".sex" file;
    BEGIN
	CHN←GETCHAN;
	OPEN(CHN,"DSK",0,0,0,512,BRK,BRK);
	LOOKUP(CHN,FILE:NAME[SEX_FILE]&"."&FILE:EXT[SEX_FILE]&FILE:PPN[SEX_FILE],BRK);
	RENAME(CHN,NULL,0,BRK);
	RELEASE(CHN)
    END;

    NF←TRUE;
    BS←STTBLK(ST);
    WLDASG(BS,CURWLD,CURWLD,NF);
    BS ← ST;
    IF ¬FILE:EOF[LST_FILE] THEN
    BEGIN
	IF FILE:EXT[LST_FILE]=NULL THEN FILE:EXT[LST_FILE]←"ALL";
	SETPRINT(FILE:NAME[LST_FILE]&"."&FILE:EXT[LST_FILE]&FILE:PPN[LST_FILE],"F");
	ALPRIN(BS);
	SETPRINT(NULL,"T")
    END;

    STINTERP(BS);	! simulation phase;

    IF ¬FILE:EOF[OUT_FILE] THEN
    BEGIN
	$RECGC;		! Garbage collect;
	INITOUT(FILE:NAME[OUT_FILE],FILE:PPN[OUT_FILE]);
	TSCAN(BS);	! code emission phase;
	CLOSEOUT;
	IF FILE:EXT[OUT_FILE]=NULL THEN FILE:EXT[OUT_FILE]←"BIN";
	IF FILE:PPN[OUT_FILE]=NULL THEN FILE:PPN[OUT_FILE]←GETPPN;
	IF PALX_LST≠NULL THEN PALX_LST←PALX_LST&FILE:PPN[OUT_FILE];
	TMPOUT("PAL",FILE:NAME[OUT_FILE]&"."&FILE:EXT[OUT_FILE]&FILE:PPN[OUT_FILE]
	    &PALX_LST&"←COMP1.PAL[AL,HE],"&FILE:NAME[OUT_FILE]&".ALP"
	    &FILE:PPN[OUT_FILE]&","
	    &FILE:NAME[OUT_FILE]&".ALT,"&FILE:NAME[OUT_FILE]&".ALV,"
	    &"COMP2.PAL[AL,HE]"&'15&'12&"ALSOAP.DMP[AL,HE]!",BRK);
	IF BRK THEN USERERR(0,1,"TMPOUT lost");
	CALL('1000000+LOCATION(RUN[1]),"RUN")
    END
END

ELSE BEGIN
    STRING PPN;
    INI_OUTPUT;
    OUTSTR("OUTPUT PPN ( [foo . bar] ) = ");
    PPN←INCHWL;

    WHILE TRUE DO
	BEGIN  "trial"
	STRING COMP;
	OUTSTR("OUTPUT FILE: ");
	COMP←INCHWL;
	IF COMP=NULL THEN COMP←"COMP";
	INITOUT(COMP,PPN);
	SE←READ;
	ST←GROVEL(SE);
	NF←TRUE;
	BS←STTBLK(ST);
	WLDASG(BS,CURWLD,CURWLD,NF);
	BS ← ST;
	ALPRIN(BS);
	SETPRINT(NULL,"T");
	PRINT(CRLF);
	PRINT(CRLF&"BEGINNING SIMULATION PHASE"&CRLF);
	STINTERP(BS); $RECGC;
	PRINT(CRLF&"BEGINNING CODE EMISSION PHASE"&CRLF);
	TSCAN(BS);
    END "trial";
END;

END "alc";